home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / XLISP.LZH / XLISPSRC.ARC / PCSTUFF.C < prev    next >
Text File  |  1986-06-01  |  7KB  |  380 lines
  1. /* pcstuff.c - ibm-pc specific routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. #define LBSIZE 200
  6.  
  7. /* external routines */
  8. extern double ran();
  9.  
  10. /* external variables */
  11. extern NODE *s_unbound,*true;
  12. extern int prompt;
  13. extern int errno;
  14. extern FILE *tfp;
  15.  
  16. /* line buffer variables */
  17. static char lbuf[LBSIZE];
  18. static int  lpos[LBSIZE];
  19. static int lindex;
  20. static int lcount;
  21. static int lposition;
  22.  
  23. /* osinit - initialize */
  24. osinit(banner)
  25.   char *banner;
  26. {
  27.     printf("%s\n",banner);
  28.     lposition = 0;
  29.     lindex = 0;
  30.     lcount = 0;
  31. }
  32.  
  33. /* osfinish - clean up before returning to the operating system */
  34. osfinish()
  35. {
  36. }
  37.  
  38. /* osrand - return a random number between 0 and n-1 */
  39. int osrand(n)
  40.   int n;
  41. {
  42.     n = (int)(ran() * (double)n);
  43.     return (n < 0 ? -n : n);
  44. }
  45.  
  46. /* osgetc - get a character from the terminal */
  47. int osgetc(fp)
  48.   FILE *fp;
  49. {
  50.     int ch;
  51.  
  52.     /* check for input from a file other than stdin */
  53.     if (fp != stdin)
  54.     return (agetc(fp));
  55.  
  56.     /* check for a buffered character */
  57.     if (lcount--)
  58.     return (lbuf[lindex++]);
  59.  
  60.     /* get an input line */
  61.     for (lcount = 0; ; )
  62.     switch (ch = xgetc()) {
  63.     case '\r':
  64.         lbuf[lcount++] = '\n';
  65.         xputc('\r'); xputc('\n'); lposition = 0;
  66.         if (tfp)
  67.             for (lindex = 0; lindex < lcount; ++lindex)
  68.             osputc(lbuf[lindex],tfp);
  69.         lindex = 0; lcount--;
  70.         return (lbuf[lindex++]);
  71.     case '\010':
  72.     case '\177':
  73.         if (lcount) {
  74.             lcount--;
  75.             while (lposition > lpos[lcount]) {
  76.             xputc('\010'); xputc(' '); xputc('\010');
  77.             lposition--;
  78.             }
  79.         }
  80.         break;
  81.     case '\032':
  82.         osflush();
  83.         return (EOF);
  84.     default:
  85.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  86.             lbuf[lcount] = ch;
  87.             lpos[lcount] = lposition;
  88.             if (ch == '\t')
  89.             do {
  90.                 xputc(' ');
  91.             } while (++lposition & 7);
  92.             else {
  93.             xputc(ch); lposition++;
  94.             }
  95.             lcount++;
  96.         }
  97.         else {
  98.             osflush();
  99.             switch (ch) {
  100.             case '\003':    xltoplevel();    /* control-c */
  101.             case '\007':    xlcleanup();    /* control-g */
  102.             case '\020':    xlcontinue();    /* control-p */
  103.             case '\032':    return (EOF);    /* control-z */
  104.             default:        return (ch);
  105.             }
  106.         }
  107.     }
  108. }
  109.  
  110. /* osputc - put a character to the terminal */
  111. osputc(ch,fp)
  112.   int ch; FILE *fp;
  113. {
  114.     /* check for output to something other than stdout */
  115.     if (fp != stdout)
  116.     return (aputc(ch,fp));
  117.  
  118.     /* check for control characters */
  119.     oscheck();
  120.  
  121.     /* output the character */
  122.     if (ch == '\n') {
  123.     xputc('\r'); xputc('\n');
  124.     lposition = 0;
  125.     }
  126.     else {
  127.     xputc(ch);
  128.     lposition++;
  129.     }
  130.  
  131.     /* output the character to the transcript file */
  132.     if (tfp)
  133.     osputc(ch,tfp);
  134. }
  135.  
  136. /* oscheck - check for control characters during execution */
  137. oscheck()
  138. {
  139.     int ch;
  140.     if (ch = xcheck())
  141.     switch (ch) {
  142.     case '\002':    osflush(); xlbreak("BREAK",s_unbound); break;
  143.     case '\003':    osflush(); xltoplevel(); break;
  144.     }
  145. }
  146.  
  147. /* osflush - flush the input line buffer */
  148. osflush()
  149. {
  150.     lindex = lcount = 0;
  151.     osputc('\n',stdout);
  152.     prompt = 1;
  153. }
  154.  
  155. /* xgetc - get a character from the terminal without echo */
  156. static int xgetc()
  157. {
  158.     return (scr_getc() & 0xFF);
  159. }
  160.  
  161. /* xputc - put a character to the terminal */
  162. static xputc(ch)
  163.   int ch;
  164. {
  165.     scr_putc(ch);
  166. }
  167.  
  168. /* xcheck - check for a character */
  169. static int xcheck()
  170. {
  171.     if (scr_poll() == -1)
  172.     return (0);
  173.     return (scr_getc() & 0xFF);
  174. }
  175.  
  176. /* xdos - execute a dos command */
  177. NODE *xdos(args)
  178.   NODE *args;
  179. {
  180.     char *cmd;
  181.     cmd = xlmatch(STR,&args)->n_str;
  182.     xllastarg(args);
  183.     return (system(cmd) == -1 ? cvfixnum((FIXNUM)errno) : true);
  184. }
  185.  
  186. /* xgetkey - get a key from the keyboard */
  187. NODE *xgetkey(args)
  188.   NODE *args;
  189. {
  190.     xllastarg(args);
  191.     return (cvfixnum((FIXNUM)scr_getc()));
  192. }
  193.  
  194. /* xcursor - set the cursor position */
  195. NODE *xcursor(args)
  196.   NODE *args;
  197. {
  198.     int row,col;
  199.     row = xlmatch(INT,&args)->n_int;
  200.     col = xlmatch(INT,&args)->n_int;
  201.     xllastarg(args);
  202.     scr_curs(row,col);
  203.     return (NIL);
  204. }
  205.  
  206. /* xclear - clear the screen */
  207. NODE *xclear(args)
  208.   NODE *args;
  209. {
  210.     xllastarg(args);
  211.     scr_clear();
  212.     return (NIL);
  213. }
  214.  
  215. /* xeol - clear to end of line */
  216. NODE *xeol(args)
  217.   NODE *args;
  218. {
  219.     xllastarg(args);
  220.     scr_eol();
  221.     return (NIL);
  222. }
  223.  
  224.  
  225. /* xeos - clear to end of screen */
  226. NODE *xeos(args)
  227.   NODE *args;
  228. {
  229.     xllastarg(args);
  230.     scr_eos();
  231.     return (NIL);
  232. }
  233.  
  234. /* xlinsert - insert line */
  235. NODE *xlinsert(args)
  236.   NODE *args;
  237. {
  238.     xllastarg(args);
  239.     scr_linsert();
  240.     return (NIL);
  241. }
  242.  
  243. /* xldelete - delete line */
  244. NODE *xldelete(args)
  245.   NODE *args;
  246. {
  247.     xllastarg(args);
  248.     scr_ldelete();
  249.     return (NIL);
  250. }
  251.  
  252. /* xcinsert - insert character */
  253. NODE *xcinsert(args)
  254.   NODE *args;
  255. {
  256.     xllastarg(args);
  257.     scr_cinsert();
  258.     return (NIL);
  259. }
  260.  
  261. /* xcdelete - delete character */
  262. NODE *xcdelete(args)
  263.   NODE *args;
  264. {
  265.     xllastarg(args);
  266.     scr_cdelete();
  267.     return (NIL);
  268. }
  269.  
  270. /* xinverse - set/clear inverse video */
  271. NODE *xinverse(args)
  272.   NODE *args;
  273. {
  274.     NODE *val;
  275.     val = xlarg(&args);
  276.     xllastarg(args);
  277.     scr_invers(val ? 1 : 0);
  278.     return (NIL);
  279. }
  280.  
  281. /* xline - draw a line */
  282. NODE *xline(args)
  283.   NODE *args;
  284. {
  285.     int x1,y1,x2,y2;
  286.     x1 = xlmatch(INT,&args)->n_int;
  287.     y1 = xlmatch(INT,&args)->n_int;
  288.     x2 = xlmatch(INT,&args)->n_int;
  289.     y2 = xlmatch(INT,&args)->n_int;
  290.     xllastarg(args);
  291.     line(x1,y1,x2,y2);
  292.     return (NIL);
  293. }
  294.  
  295. /* xpoint - draw a point */
  296. NODE *xpoint(args)
  297.   NODE *args;
  298. {
  299.     int x,y;
  300.     x = xlmatch(INT,&args)->n_int;
  301.     y = xlmatch(INT,&args)->n_int;
  302.     xllastarg(args);
  303.     point(x,y);
  304.     return (NIL);
  305. }
  306.  
  307. /* xcircle - draw a circle */
  308. NODE *xcircle(args)
  309.   NODE *args;
  310. {
  311.     int x,y,r;
  312.     x = xlmatch(INT,&args)->n_int;
  313.     y = xlmatch(INT,&args)->n_int;
  314.     r = xlmatch(INT,&args)->n_int;
  315.     xllastarg(args);
  316.     circle(x,y,r);
  317.     return (NIL);
  318. }
  319.  
  320. /* xaspect - set the aspect ratio */
  321. NODE *xaspect(args)
  322.   NODE *args;
  323. {
  324.     int x,y;
  325.     x = xlmatch(INT,&args)->n_int;
  326.     y = xlmatch(INT,&args)->n_int;
  327.     xllastarg(args);
  328.     set_asp(x,y);
  329.     return (NIL);
  330. }
  331.  
  332. /* xcolors - setup the display colors */
  333. NODE *xcolors(args)
  334.   NODE *args;
  335. {
  336.     int c,p,b;
  337.     c = xlmatch(INT,&args)->n_int;
  338.     p = xlmatch(INT,&args)->n_int;
  339.     b = xlmatch(INT,&args)->n_int;
  340.     xllastarg(args);
  341.     color(c);
  342.     palette(p);
  343.     ground(b);
  344.     return (NIL);
  345. }
  346.  
  347. /* xmode - set the display mode */
  348. NODE *xmode(args)
  349.   NODE *args;
  350. {
  351.     int m;
  352.     m = xlmatch(INT,&args)->n_int;
  353.     xllastarg(args);
  354.     mode(m);
  355.     return (NIL);
  356. }
  357.  
  358. /* osfinit - initialize pc specific functions */
  359. osfinit()
  360. {
  361.     xlsubr("DOS",        SUBR,    xdos);
  362.     xlsubr("GET-KEY",        SUBR,    xgetkey);
  363.     xlsubr("SET-CURSOR",    SUBR,    xcursor);
  364.     xlsubr("CLEAR",        SUBR,    xclear);
  365.     xlsubr("CLEAR-EOL",        SUBR,    xeol);
  366.     xlsubr("CLEAR-EOS",        SUBR,    xeos);
  367.     xlsubr("INSERT-LINE",    SUBR,    xlinsert);
  368.     xlsubr("DELETE-LINE",    SUBR,    xldelete);
  369.     xlsubr("INSERT-CHAR",    SUBR,    xcinsert);
  370.     xlsubr("DELETE-CHAR",    SUBR,    xcdelete);
  371.     xlsubr("SET-INVERSE",    SUBR,    xinverse);
  372.     xlsubr("LINE",         SUBR,    xline);
  373.     xlsubr("POINT",        SUBR,    xpoint);
  374.     xlsubr("CIRCLE",        SUBR,    xcircle);
  375.     xlsubr("ASPECT-RATIO",    SUBR,    xaspect);
  376.     xlsubr("COLORS",        SUBR,    xcolors);
  377.     xlsubr("MODE",         SUBR,    xmode);
  378. }
  379.  
  380.